perm filename GRAPH.SAI[X,ALS] blob sn#086477 filedate 1974-02-07 generic text, type T, neo UTF8
00010	BEGIN "GRAPH"
00020	DEFINE ⊂="COMMENT";
00030	DEFINE ⊃="⊂";
00040	DEFINE CR="'15",LF="'12",CRLF="CR&LF",TB="'11";
00050	REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
00060	  INTEGER I,J,K,L,M,X,Y,LX,LY,DX,DY,CHAN1,CHAN5,EOF,PP,POINTP,FLAG,MUTE,NUM;
00070	  STRING FILEP,FILEN,READ,MEMO; BOOLEAN ER;
00080	  INTEGER ARRAY SAVE,ADR,ADRX,ADRS[0:5];
00090	  INTEGER ARRAY LFILE[0:127];
00100	  INTEGER ARRAY NEW[0:511];
00110	  INTEGER ARRAY DPYBUF[0:4096];
00120	INTEGER A1,A2,A3;
00130	LABEL STARTP;
00140	INTEGER DATE,TIME;
00150	DEFINE GETIME="BEGIN DATE←CALL(0,""DATE""); TIME←CALL(0,""TIMER"")%60; END;";
00160	PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG",
00170		"SEP","OCT","NOV","DEC";
00180	STRING ARRAY MONTHS[0:11];
00190	
00200	INTERNAL STRING PROCEDURE DATIM;
00210	BEGIN
00220	INTEGER DAY,YR,HRS,MIN,SEC;
00230	DAY←(DATE MOD 31)+1;DATE←DATE%31;
00240	YR←1964+DATE%12; SEC←TIME MOD 60;
00250	TIME←TIME%60; MIN←TIME MOD 60; HRS←TIME%60;
00260	SETFORMAT(-2,0);
00270	RETURN(CVS(DAY)&"-"&MONTHS[DATE MOD 12]&
00280	   "-"&CVS(YR)&"   "&CVS(HRS)&CVS(MIN)&":"&CVS(SEC));
00290	END;
00300	
00310	INTERNAL STRING PROCEDURE WTIM;
00320	BEGIN
00330	DATE←SAVE[2] LAND '7777; TIME←LDB(POINT(11,SAVE[2],23))*60;
00340	RETURN(DATIM);
00350	END;
00360	
00370	INTERNAL STRING PROCEDURE DATIME;
00380	BEGIN
00390	GETIME;
00400	RETURN(DATIM);
00410	END;
00420	
00430	
00440	⊂ Allow 1140 units on a line corresponding to 76 charactters @15 units,
00450	   380 segments @ 3 and 48640 samples @ 3/128 unit, or 2.432 seconds;
00460	
00470	
     

00010	STARTP:
00020	MUTE←60; NUM←3;
00030	ADR[0]←CVSIX("DSK");
00040	ADR[1]←CVSIX("XRUN  ");
00050	ADR[2]←CVSIX("DMP") LOR '4;
00060	ADR[3]←0;
00070	ADR[4]←CVSIX("  XALS");
00080	ADR[5]←CVSIX("  XALS");
00090	
00100	ADRX[0]←CVSIX("DSK");
00110	ADRX[1]←CVSIX("BXX   ");
00120	ADRX[2]←CVSIX("DMP") LOR '4;
00130	ADRX[3]←0;
00140	ADRX[4]←CVSIX("PITNJM");
00150	ADRX[5]←CVSIX("  XALS");
00160	
00170	ADRS[0]←CVSIX("DSK");
00180	ADRS[1]←CVSIX("SAY   ");
00190	ADRS[2]←CVSIX("DMP") LOR '4;
00200	ADRS[3]←0;
00210	ADRS[4]←CVSIX("  XALS");
00220	ADRS[5]←CVSIX("  XALS");
00230	
00240	OUTSTR("The following set-up commands of a letter followed by a number "
00250	  &"may be given:"&CRLF);
00260	OUTSTR("	M#	sets MUTE level (default value 60)"&CRLF&
00270	       "	N#	sets number of formants (default value 3)."&CRLF);
00280	OUTSTR("A number only uses preset values for M and N and specifies the file to use."
00290	      &CRLF&TB&"A CR only calls for file # 1."&CRLF&LF);
00300	OUTSTR("After a display has appeared the following single character "&
00310	   "commands may also be given:"
00320	&CRLF&TB&"X	prepare XGP.BIG for the XGP"
00330	&CRLF&TB&"R	run XGP from file XGP.BIG"
00340	&CRLF&TB&"S	speaker output of utterance"
00350	&CRLF&TB&"E	exit from the program"&CRLF&LF);
00360	
00370	SETFORMAT(1,0); FLAG←0; X←0;
00380	WHILE TRUE DO BEGIN "TYPE" OUTSTR("Type command  "); READ←INCHWL;
00390	IF READ[1 TO 1]="M" THEN BEGIN MUTE←CVD(READ[2 TO 4]);CONTINUE "TYPE";END;
00400	IF READ[1 TO 1]="N" THEN BEGIN NUM←CVD(READ[2 TO 2]);CONTINUE "TYPE";END;
00410	DONE; END "TYPE";
00420	IF READ="" THEN PP←1 ELSE PP←CVD(READ);
00430	FILEP←"SEG"&CVS(PP)&".SYN[SYN,ALS]";
00440	SETFORMAT(-3,0); FILEN←"HI20."&CVS(PP)&"[CMP,VIN]"; SETFORMAT(1,0);
00450	
00460	CLOSE(CHAN5); OPEN(CHAN5,"DSK",'10,2,0,0,0,EOF);
00470	LOOKUP(CHAN5,FILEP,ER);
00480	IF ER THEN OUTSTR("FILE "&FILEP&"  NOT FOUND"&CRLF);
00490	ARRYIN(CHAN5,LFILE[0],'200);
00500	
00510	DPYSET(DPYBUF); SETFORMAT(2,0); AIVECT(-560,0);
00520	⊂ Vertical numbers and vertical scale;
00530	FOR K←1 STEP 1 UNTIL 2 DO BEGIN
00540	
00550	RIVECT(-35,-7);
00560	FOR I←0 STEP 1 UNTIL 5 DO BEGIN
00570	  DPYSST(CVS(I)); RIVECT(-30,75);
00580	  END; RIVECT(35,7); RIVECT(0,-450);
00590	
00600	FOR I←0 STEP 1 UNTIL 5 DO BEGIN
00610	  RIVECT(20,0); RVECT(-20,0);
00620	  IF I=5 THEN DONE;
00630	  RVECT(0,15);
00640	  FOR J←1 STEP 1 UNTIL 4 DO BEGIN
00650	  RIVECT(10,0); RVECT(-10,0);RVECT(0,15); END;
00660	  END;
00670	
00680	 RIVECT(0,-375);   RVECT(570,0);  RVECT(570,0);
00690	AIVECT(-560,-460); END;
00700	⊃ DPYOUT(0);
00710	
00720	FLAG←0; AIVECT(-560,-30);
00730	FOR I←21 STEP 1 UNTIL 127 DO BEGIN "PONY"
00740	  IF LFILE[I]=0 THEN DONE;
00750	  L←LFILE[I] LAND '777760000000;
00760	  J←LDB(POINT(14,LFILE[I],27)); K←LDB(POINT(8,LFILE[I],35));
00770	
00780	  IF X<J%5 THEN FOR M←X STEP 1 UNTIL J%5 DO BEGIN
00790	    DPYSST(" "); X←X+1;
00800	    IF X≥76 THEN IF FLAG=0 THEN BEGIN FLAG←1;
00810	      AIVECT(-560,-490); ⊂ RIVECT(-570,-460); ⊂ RIVECT(-570,0);  END;
00820	    IF X≥152 THEN DONE "PONY";
00830	    END;
00840	  IF K<5 THEN K←5;
00850	  FOR M←1 STEP 1 UNTIL K%5 DO BEGIN
00860	    DPYSST(CVSTR(L)[1 TO 1]); IF (READ←CVSTR(L)[2 TO 2])≠"" THEN BEGIN
00870	      RIVECT(-15,-20); DPYSST(READ); RIVECT(0,20); END;
00880	     X←X+1;
00890	    IF X≥76 THEN IF FLAG=0 THEN BEGIN FLAG←1;
00900	      AIVECT(-560,-490); ⊂ RIVECT(-570,-460); ⊂ RIVECT(-570,0); END;
00910	    IF X≥152 THEN DONE "PONY";
00920	    END;
00930	  END "PONY";
00940	⊃ DPYOUT(0);
00950	
00960	FLAG←0; AIVECT(0,0);
00970	
00980	FOR I←0 STEP 1 UNTIL 5 DO SAVE[I]←0;
00990	WHILE EOF=0 DO BEGIN "DATIN"
01000	  ARRYIN(CHAN5,NEW[0],512);
01010	
01020	  FOR I←1 STEP 1 UNTIL NUM DO BEGIN "PLOT"
01030	    LY←SAVE[I]; LX←SAVE[0]; RIVECT(LX-560,LY);
01040	    FOR J←0 STEP 8 UNTIL 504 DO BEGIN
01050	      IF NEW[J]=0 THEN DONE;
01060	      X←(NEW[J] LSH -15)*3%128;
01070	      IF FLAG=2 THEN BEGIN X←X-1140; IF X>1140 THEN DONE; END;
01080	      IF (LX≥1140)∧(FLAG=0) THEN BEGIN
01090	          FLAG←1; RIVECT(-570,-460);  RIVECT(-570,0); END;
01100	
01110	      POINTP←POINT(9,NEW[J+1],-1);
01120	      FOR K←1 STEP 1 UNTIL I DO IBP(POINTP);
01130	      Y← LDB(POINTP)*3;
01140	      IF Y=0 THEN Y←LY;
01150	⊃  OUTSTR(CVS(X)&","&CVS(Y)&TB&TB);
01160	      DX←X-LX; LX←X; DY←Y-LY; LY←Y;
01170	⊂      IF X=0 THEN IF J≠0 THEN BEGIN RIVECT(DX,DY); ⊂  DONE; ⊂  END;
01180	      IF (LDB(POINT(9,NEW[J+2],17)) < MUTE)∨(DX<3)
01190	        THEN RIVECT(DX,DY) ELSE  RVECT(DX,DY);
01200	      END;
01210	    IF FLAG=1 THEN BEGIN
01220	      FLAG←0; RIVECT(570,460); RIVECT(570,0); END;
01230	    SAVE[I]←LY; RIVECT(560-LX,-LY);
01240	    END "PLOT";
01250	  IF X=0 THEN DONE "DATIN";
01260	  IF FLAG=2 THEN IF X>1140 THEN DONE "DATIN";
01270	
01280	  IF LX≥1140 THEN BEGIN FLAG←2;
01290	    RIVECT(0,-460); LX←LX-1140; END;
01300	  SAVE[0]←LX;
01310	  END "DATIN";
01320	CLOSE(CHAN5);
01330	
01340	TYPLOC(512,300); DPYOUT(0);
01350	WHILE TRUE DO BEGIN "WHAT"
01360	  OUTSTR("Now what? ");
01370	IF ((READ←INCHRW)="X")∨(READ="x") THEN BEGIN 
01380	  OUTSTR(CRLF&"Type memo (if desired) and CR ");
01390	MEMO←INCHWL;
01400	CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,0,1,0,EOF,0);
01410	ENTER(CHAN1,"NUMBER.TMP",0);
01420	OUT(CHAN1,CVS(PP)&CRLF);
01430	OUT(CHAN1,MEMO&CRLF);
01440	CLOSE(CHAN1); RELEASE(CHAN1);
01450	  START_CODE MOVEI 0,ADR[0]; CALLI '400004; END;
01460	  OUTSTR(CRLF&"Type R to run BXX and produce XGP output from XGP.BIG"&CRLF);
01470	  OUTSTR("⊗"); CONTINUE "WHAT";
01480	  END;
01490	
01500	IF (READ="S")∨(READ="s") THEN BEGIN
01510	  COMMENT Preset ESC 4 U ;
01520	CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,0,1,0,EOF,0);
01530	ENTER(CHAN1,"NUMBER.TMP",0);
01540	OUT(CHAN1,CVS(PP)&CRLF);
01550	CLOSE(CHAN1); RELEASE(CHAN1);
01560	  START_CODE MOVEI 0,ADRS[0]; CALLI '400004; END;
01570	  OUTSTR(CRLF&"⊗");  CONTINUE "WHAT";
01580	  END;
01590	
01600	
01610	IF (READ="R")∨(READ="r") THEN BEGIN
01620	  COMMENT Runs BXX;
01630	  ER←1;
01640	  WHILE ER DO BEGIN
01650	    ER←0;
01660	    CLOSE(CHAN1); OPEN(CHAN1,"DSK",0,0,1,0,EOF,0);
01670	    LOOKUP(CHAN1,"XGP.BIG",ER);
01680	    IF ER=0 THEN BEGIN
01690	      CLOSE(CHAN1); RELEASE(CHAN1);
01700	      START_CODE MOVEI 0,ADRX[0]; CALLI '400004; END;
01710	      OUTSTR(CRLF&"⊗"); DONE; END;
01720	    IF INCHRS>0 THEN BEGIN OUTSTR(CRLF&LF&"Don't forget to try later"&crlf);
01730	      CLOSE(CHAN1); RELEASE(CHAN1); DONE; END;
01740	    OUTSTR("*Waiting ");
01750	    END;
01760	  CONTINUE "WHAT";
01770	  END;
01780	DONE;
01790	END "WHAT";
01800	IF (READ≠"E")∧(READ≠"e") THEN GOTO STARTP;
01810	PTOCHW(0,'10103);
01820	END "GRAPH";